Add option to select display-buffer function.

Only 2 are implemented at the moment.

diff --git a/which-key.el b/which-key.el
index 28026641d1c42484b4a8d3887c6e9be16f960263..d7745ddb8fbfff4d21b031df7c7c5153eee48235 100644 (file)
--- a/which-key.el
+++ b/which-key.el
@@ -40,6 +40,13 @@
   "Name of which-key buffer.")
 (defvar which-key-buffer-position 'bottom
   "Position of which-key buffer")
+(defvar which-key-buffer-display-function
+  'display-buffer-in-side-window
+  "Controls where the buffer is displayed. Current options are
+  the default which is also controlled by
+  `which-key-buffer-position', and
+  `display-buffer-below-selected' which displays which-key only
+  under the currently selected window.")
 (defvar which-key-vertical-buffer-width 60
   "Width of which-key buffer .")
 
@@ -55,6 +62,7 @@
 (defvar which-key--setup-p nil
   "Internal: Non-nil if which-key buffer has been setup")
 
+
 (define-minor-mode which-key-mode
   "Toggle which-key-mode."
   :global t
@@ -73,23 +81,26 @@
       (concat (substring desc 0 which-key-max-description-length) "..")
     desc))
 
-(defun which-key/format-matches (key-desc-cons max-len-key max-len-desc)
+(defun which-key/format-matches (unformatted max-len-key max-len-desc)
   "Turn `key-desc-cons' into formatted strings (including text
 properties), and pad with spaces so that all are a uniform
 length."
-  (let* ((key (car key-desc-cons))
-         (desc (cdr key-desc-cons))
-         (group (string-match-p "^group:" desc))
-         (prefix (string-match-p "^Prefix" desc))
-         (desc-face (if (or prefix group)
-                        'font-lock-keyword-face 'font-lock-function-name-face))
-         (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc)))
-         (key-padding (s-repeat (- max-len-key (length key)) " "))
-         (padded-desc (s-pad-right max-len-desc " " tmp-desc)))
-    (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s"
-                    (propertize "]" 'face 'font-lock-comment-face) "%s"
-                    (propertize " %s" 'face desc-face))
-            key key-padding padded-desc)))
+  (mapcar
+   (lambda (key-desc-cons)
+     (let* ((key (car key-desc-cons))
+            (desc (cdr key-desc-cons))
+            (group (string-match-p "^group:" desc))
+            (prefix (string-match-p "^Prefix" desc))
+            (desc-face (if (or prefix group)
+                           'font-lock-keyword-face 'font-lock-function-name-face))
+            (tmp-desc (which-key/truncate-description (if group (substring desc 6) desc)))
+            (key-padding (s-repeat (- max-len-key (length key)) " "))
+            (padded-desc (s-pad-right max-len-desc " " tmp-desc)))
+       (format (concat (propertize "[" 'face 'font-lock-comment-face) "%s"
+                       (propertize "]" 'face 'font-lock-comment-face) "%s"
+                       (propertize " %s" 'face desc-face))
+               key key-padding padded-desc)))
+   unformatted))
 
 (defun which-key/replace-strings-from-alist (replacements)
   "Find and replace text in buffer according to REPLACEMENTS,
@@ -104,16 +115,45 @@ replace and the cdr is the replacement text. "
           (setq old-face (get-text-property (match-beginning 0) 'face))
           (replace-match (propertize (cdr rep) 'face old-face) nil t))))))
 
-(defun which-key/get-vertical-buffer-width (max-len-key max-len-desc)
-  (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key)))
+(defun which-key/buffer-width (max-len-key max-len-desc sel-window-width)
+  (cond ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window)
+              (member which-key-buffer-position '(left right)))
+         (min which-key-vertical-buffer-width (+ 3 max-len-desc max-len-key)))
+        ((eq which-key-buffer-display-function 'display-buffer-in-side-window)
+         (frame-width))
+        ((eq which-key-buffer-display-function 'display-buffer-below-selected)
+         sel-window-width)
+        (t nil)))
+
+(defsubst which-key/buffer-height (line-breaks) (+ 2 line-breaks))
+
+;; (defun which-key/window-params-alist (max-len-key max-len-desc line-breaks selected-buf)
+;;   (let ((disp-func which-key-buffer-display-function)
+;;         (position which-key-buffer-position)
+;;         (selected-window (buffer-w))
+;;         width height side)
+;;     (cond
+;;      ((and (eq disp-func 'display-buffer-in-side-window)
+;;            (member position '(left right)))
+;;       (setq width (which-key/vertical-buffer-width max-len-desc max-len-key)
+;;             height (frame-height)
+;;             side position))
+;;      ((eq disp-func 'display-buffer-in-side-window)
+;;       (setq width (frame-width)
+;;             height (+ 2 line-breaks)
+;;             side position))
+;;      ((eq disp-func 'display-buffer-below-selected)
+;;       (setq height (+ 2 line-breaks)))
+;;      (t (error "error: Using unsupported buffer display function")))
+;;     (list (when width (cons 'window-width width))
+;;           (cons 'window-height height)
+;;           (when side (cons 'side side)))))
 
-(defun which-key/insert-keys (formatted-strings vertical-buffer-width)
+(defun which-key/insert-keys (formatted-strings buffer-width)
   "Insert strings into buffer breaking after `which-key-buffer-width'."
   (let ((char-count 0)
         (line-breaks 0)
-        (width (if vertical-buffer-width
-                   vertical-buffer-width
-                   (frame-width))))
+        (width (if buffer-width buffer-width (frame-width))))
     (insert (mapconcat
              (lambda (str)
                (let* ((str-len (length (substring-no-properties str)))
@@ -134,19 +174,22 @@ Finally, show the buffer."
         (progn
           (when which-key--close-timer (cancel-timer which-key--close-timer))
           (which-key/hide-buffer)
-          (let ((buf (current-buffer))
+          (let ((buf (current-buffer)) (win-width (window-width))
                 (key-str-qt (regexp-quote (key-description key)))
                 (bottom-or-top (member which-key-buffer-position '(top bottom)))
-                (max-len-key 0) (max-len-desc 0) key-match desc-match
-                unformatted formatted buffer-height buffer-width vertical-buffer-width)
+                (max-len-key 0) (max-len-desc 0)
+                key-match desc-match unformatted formatted buffer-width
+                line-breaks)
             ;; get keybindings
             (with-temp-buffer
               (describe-buffer-bindings buf key)
               (goto-char (point-max))
               (while (re-search-backward
-                      (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$" key-str-qt)
+                      (format "^%s \\([^ \t]+\\)[ \t]+\\(\\(?:[^ \t\n]+ ?\\)+\\)$"
+                              key-str-qt)
                       nil t)
-                (setq key-match (s-replace-all which-key-key-replacement-alist (match-string 1))
+                (setq key-match (s-replace-all
+                                 which-key-key-replacement-alist (match-string 1))
                       desc-match (match-string 2)
                       max-len-key (max max-len-key (length key-match))
                       max-len-desc (max max-len-desc (length desc-match)))
@@ -154,23 +197,24 @@ Finally, show the buffer."
                             :test (lambda (x y) (string-equal (car x) (car y)))))
               (setq max-len-desc (if (> max-len-desc which-key-max-description-length)
                                      (+ 2 which-key-max-description-length) ; for the ..
-                                   max-len-desc))
-              (setq formatted (mapcar (lambda (str)
-                                        (which-key/format-matches str max-len-key max-len-desc))
-                                      unformatted)))
+                                   max-len-desc)
+                    formatted (which-key/format-matches
+                               unformatted max-len-key max-len-desc)))
             (with-current-buffer (get-buffer which-key--buffer)
               (erase-buffer)
-              (setq vertical-buffer-width
-                    (which-key/get-vertical-buffer-width max-len-desc max-len-key)
-                    buffer-line-breaks
-                    (which-key/insert-keys formatted (unless bottom-or-top vertical-buffer-width)))
+              (setq buffer-width (which-key/buffer-width
+                                  max-len-key max-len-desc win-width)
+                    line-breaks  (which-key/insert-keys
+                                  formatted buffer-width))
               (goto-char (point-min))
-              (which-key/replace-strings-from-alist which-key-general-replacement-alist)
-              (if bottom-or-top
-                  (setq buffer-height (+ 2 buffer-line-breaks))
-                (setq buffer-width vertical-buffer-width)))
-            (setq which-key--window (which-key/show-buffer buffer-height buffer-width))
-            (setq which-key--close-timer (run-at-time which-key-close-buffer-idle-delay nil 'which-key/hide-buffer))))
+              (which-key/replace-strings-from-alist
+               which-key-general-replacement-alist))
+            (setq which-key--window (which-key/show-buffer
+                                     (which-key/buffer-height line-breaks)
+                                     buffer-width))
+            (setq which-key--close-timer (run-at-time
+                                          which-key-close-buffer-idle-delay
+                                          nil 'which-key/hide-buffer))))
       ;; close the window
       (when (window-live-p which-key--window) (which-key/hide-buffer)))))
 
@@ -187,10 +231,12 @@ Finally, show the buffer."
 ;;    :position which-key-buffer-position))
 
 (defun which-key/show-buffer (height width)
-  (setq alist (list (cons 'side which-key-buffer-position)
-                    (when height (cons 'window-height  height))
-                    (when width  (cons 'window-width  width))))
-   (display-buffer "*which-key*" (cons 'display-buffer-in-side-window alist)))
+  (let ((side which-key-buffer-position) alist)
+    (setq alist (list (when side   (cons 'side side))
+                      (when height (cons 'window-height  height))
+                      (when width  (cons 'window-width  width))))
+    (message "h: %s w: %s s: %s" height width side)
+    (display-buffer "*which-key*" (cons which-key-buffer-display-function alist))))
 
 (defun which-key/hide-buffer ()
   "Like it says :\)"